/// The types that the user sees
module LibExecution.ProgramTypes

open Prelude


type NameValidator<'name> = 'name -> unit
type NamePrinter<'name> = 'name -> string

// Lowercase starting letter for modules and users
let modulePattern = @"^[A-Z][a-z0-9A-Z_]*$"
//let typeNamePattern = @"^[A-Z][a-z0-9A-Z_]*$"
let fnNamePattern = @"^[a-z][a-z0-9A-Z_']*$"
let builtinNamePattern = @"^(__|[a-z])[a-z0-9A-Z_]\w*$"
let valueNamePattern = @"^[a-z][a-z0-9A-Z_']*$"

let assertBuiltin
  (name : string)
  (version : int)
  (nameValidator : string -> unit)
  : unit =
  nameValidator name
  assert_ "version can't be negative" [ "version", version ] (version >= 0)


/// Fully-Qualified Type Name
///
/// Used to reference a type defined in a Package or by a User
module FQTypeName =
  /// The id of a type in the package manager
  type Package = uuid

  type FQTypeName = Package of Package

  let package (id : uuid) : Package = id

  let fqPackage (id : uuid) : FQTypeName = Package id



/// A Fully-Qualified Value Name
///
/// Used to reference a value defined by the runtime, in a Package, or by a User
module FQValueName =
  /// A value built into the runtime
  type Builtin = { name : string; version : int }

  /// The id of a value in the package manager
  type Package = uuid

  type FQValueName =
    | Builtin of Builtin
    | Package of Package


  let assertValueName (name : string) : unit =
    assertRe "Value name must match" valueNamePattern name

  let builtIn (name : string) (version : int) : Builtin =
    assertBuiltin name version assertValueName
    { name = name; version = version }

  let fqBuiltIn (name : string) (version : int) : FQValueName =
    Builtin(builtIn name version)

  let package (id : uuid) : Package = id

  let fqPackage (id : uuid) : FQValueName = Package id




/// A Fully-Qualified Function Name
///
/// Used to reference a function defined by the runtime, in a Package, or by a User
module FQFnName =
  /// A function built into the runtime
  type Builtin = { name : string; version : int }

  /// The id of a function in the package manager
  type Package = uuid

  type FQFnName =
    | Builtin of Builtin
    | Package of Package

  let assertFnName (name : string) : unit =
    assertRe $"Fn name must match" fnNamePattern name

  let builtIn (name : string) (version : int) : Builtin =
    assertBuiltin name version assertFnName
    { name = name; version = version }

  let fqBuiltIn (name : string) (version : int) : FQFnName =
    Builtin(builtIn name version)

  let package (id : uuid) : Package = id

  let fqPackage (id : uuid) : FQFnName = Package id


// In ProgramTypes, names (FnNames, TypeNames, ValueNames) have already been
// resolved. The user wrote them in WrittenTypes, and the WrittenTypesToProgramTypes
// pass looked them up and specified them exactly in ProgramTypes.
//
// However, sometimes the name/fn/type/value could not be found, which means the
// user specified a name that doesn't exist (it shouldn't be for any other reason -
// things like "the internet was down" should error differently).
//
// When there is an error, we still want to keep the rest of the expression around,
// as ProgramTypes's job is to keep the program as it was written by the user. We
// also have a goal of running invalid programs as much as possible. As such, an
// incorrectly specified name shouldn't cause a compile-time/parse-time error, nor
// should it lose information that was specified by the user.
//
// As a result, we model those cases as a Result type, where the Ok case is the
// resolved name, and the Error case models the text name of the type and some error
// information.

type NameResolutionError =
  | NotFound of List<string>
  | InvalidName of List<string>

type NameResolution<'a> = Result<'a, NameResolutionError>


type LetPattern =
  /// `let x = 1`
  | LPVariable of id * name : string

  // /// `let _ignored = 1`
  // | LPIgnored

  // /// let (x) = 1
  //| LPParens of inner : LetPattern

  /// `let (x, _) = (1, 2)`
  | LPTuple of
    id *
    first : LetPattern *
    second : LetPattern *
    theRest : List<LetPattern>

  /// `let () = ()`
  | LPUnit of id

module LetPattern =
  let rec symbolsUsed (pattern : LetPattern) : Set<string> =
    match pattern with
    | LPVariable(_, name) -> Set.singleton name
    | LPTuple(_, first, second, rest) ->
      Set.unionMany
        [ symbolsUsed first
          symbolsUsed second
          rest |> List.map symbolsUsed |> Set.unionMany ]
    | LPUnit _ -> Set.empty

  let toID (pattern : LetPattern) : id =
    match pattern with
    | LPVariable(id, _)
    | LPTuple(id, _, _, _)
    | LPUnit id -> id


/// Used for pattern matching in a match statement
type MatchPattern =
  | MPUnit of id

  | MPBool of id * bool

  | MPInt8 of id * int8
  | MPUInt8 of id * uint8
  | MPInt16 of id * int16
  | MPUInt16 of id * uint16
  | MPInt32 of id * int32
  | MPUInt32 of id * uint32
  | MPInt64 of id * int64
  | MPUInt64 of id * uint64
  | MPInt128 of id * System.Int128
  | MPUInt128 of id * System.UInt128

  | MPFloat of id * Sign * string * string

  | MPChar of id * string
  | MPString of id * string

  | MPList of id * List<MatchPattern>
  | MPListCons of id * head : MatchPattern * tail : MatchPattern
  | MPTuple of id * MatchPattern * MatchPattern * List<MatchPattern>

  | MPEnum of id * caseName : string * fieldPats : List<MatchPattern>

  | MPVariable of id * string

  | MPOr of id * NEList<MatchPattern>

type BinaryOperation =
  | BinOpAnd
  | BinOpOr

type InfixFnName =
  | ArithmeticPlus
  | ArithmeticMinus
  | ArithmeticMultiply
  | ArithmeticDivide
  | ArithmeticModulo
  | ArithmeticPower
  | ComparisonGreaterThan
  | ComparisonGreaterThanOrEqual
  | ComparisonLessThan
  | ComparisonLessThanOrEqual
  | ComparisonEquals
  | ComparisonNotEquals
  | StringConcat

type Infix =
  | InfixFnCall of InfixFnName
  | BinOp of BinaryOperation

/// Darklang's available types
/// - `Int64`
/// - `List<T>`
/// - user-defined enums
/// - etc.
type TypeReference =
  | TUnit

  | TBool

  | TInt8
  | TUInt8
  | TInt16
  | TUInt16
  | TInt32
  | TUInt32
  | TInt64
  | TUInt64
  | TInt128
  | TUInt128

  | TFloat

  | TChar
  | TString

  | TUuid
  | TDateTime

  | TList of TypeReference
  | TTuple of TypeReference * TypeReference * List<TypeReference>
  | TDict of TypeReference

  /// A type defined by a standard library module, a canvas/user, or a package
  /// e.g. `Result<Int64, String>` is represented as `TCustomType("Result", [TInt64, TString])`
  /// `typeArgs` is the list of type arguments, if any
  | TCustomType of
    // TODO: this reference should be by-hash
    NameResolution<FQTypeName.FQTypeName> *
    typeArgs : List<TypeReference>

  | TFn of arguments : NEList<TypeReference> * ret : TypeReference

  /// A named variable, eg `a` in `List<a>`, matches anything
  | TVariable of string

  | TDB of TypeReference


/// Expressions - the main part of the language.
type Expr =
  // -- Simple exprs --
  | EUnit of id
  | EBool of id * bool

  | EInt8 of id * int8
  | EUInt8 of id * uint8
  | EInt16 of id * int16
  | EUInt16 of id * uint16
  | EInt32 of id * int32
  | EUInt32 of id * uint32
  | EInt64 of id * int64
  | EUInt64 of id * uint64
  | EInt128 of id * System.Int128
  | EUInt128 of id * System.UInt128

  // Allow the user to have arbitrarily big numbers, even if they don't make sense as
  // floats. The float is split as we want to preserve what the user entered.
  // Strings are used as numbers lose the leading zeros (eg 7.00007)
  | EFloat of id * Sign * whole : string * part : string

  /// A character is an Extended Grapheme Cluster (hence why we use a string). This
  /// is equivalent to one screen-visible "character" in Unicode.
  | EChar of id * string
  | EString of id * List<StringSegment>


  // -- Flow control --
  /// `if cond then thenExpr else elseExpr`
  | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option<Expr>

  /// `(1 + 2) |> fnName |> (+) 3`
  | EPipe of id * lhs : Expr * parts : List<PipeExpr>

  /// Supports `match` expressions
  /// ```fsharp
  /// match x + 2 with // arg
  /// | pattern -> expr // cases[0]
  /// | pattern -> expr
  /// | ...
  /// ```
  // cases is a list to represent when a user starts typing but doesn't complete it
  | EMatch of id * arg : Expr * cases : List<MatchCase>

  // <summary>
  // Composed of binding pattern, the expression to create bindings for,
  // and the expression that follows, where the bound values are available
  // </summary>
  //
  // <code>
  // let str = expr1
  // expr2
  // </code>
  | ELet of id * LetPattern * Expr * Expr

  // Reference some local variable by name
  //
  // i.e. after a `let binding = value`, any use of `binding`
  | EVariable of id * string

  // Reference a function argument by its position index
  //
  // i.e. in `let fn (x: Int64) (y: String) = ...`,
  // references to `x` become `EArg(id, 0)` and `y` becomes `EArg(id, 1)`
  | EArg of id * index : int


  // -- Basic structures --
  | EList of id * List<Expr>
  | EDict of id * List<string * Expr>
  | ETuple of id * Expr * Expr * List<Expr>

  // -- "Applying" args to things, such as fns and lambdas --
  /// This is a function call, the first expression is the value of the function.
  /// - `expr (args[0])`
  /// - `expr (args[0]) (args[1])`
  /// - `expr<typeArg[0]> (args[0])`
  | EApply of id * expr : Expr * typeArgs : List<TypeReference> * args : NEList<Expr>

  /// Reference a function name, _usually_ so we can _apply_ it with args
  | EFnName of id * NameResolution<FQFnName.FQFnName>

  // Composed of a parameters * the expression itself
  // The id in the varname list is the analysis id, used to get a livevalue
  // from the analysis engine
  | ELambda of id * pats : NEList<LetPattern> * body : Expr

  /// Calls upon an infix function
  | EInfix of id * Infix * lhs : Expr * rhs : Expr


  // -- References to custom types and data --

  /// Construct a record
  /// `SomeRecord { field1: value; field2: value }`
  | ERecord of
    id *
    // TODO: this reference should be by-hash
    typeName : NameResolution<FQTypeName.FQTypeName> *
    typeArgs : List<TypeReference> *
    // User is allowed type `Name {}` even if that's an error
    fields : List<string * Expr>

  /// Access a field of some record (e.g. `someExpr.fieldName`)
  | ERecordFieldAccess of id * record : Expr * fieldName : string

  /// Clone a record, and update some of its values
  /// `{ r with key = value }`
  | ERecordUpdate of id * record : Expr * updates : NEList<string * Expr>


  // Enums include `Some`, `None`, `Error`, `Ok`, as well
  // as user-defined enums.
  //
  /// Given an Enum type of:
  ///   `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum`
  /// , this is the expression
  ///   `C (1, "title")`
  /// represented as
  ///   `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]`
  | EEnum of
    id *
    // TODO: this reference should be by-hash
    typeName : NameResolution<FQTypeName.FQTypeName> *
    typeArgs : List<TypeReference> *
    caseName : string *
    fields : List<Expr>

  | EValue of
    id *
    // TODO: this reference should be by-hash
    NameResolution<FQValueName.FQValueName>

  | EStatement of id * first : Expr * next : Expr

  | ESelf of id

and MatchCase = { pat : MatchPattern; whenCondition : Option<Expr>; rhs : Expr }

and StringSegment =
  | StringText of string
  | StringInterpolation of Expr

and PipeExpr =
  /// `1 |> fun x -> x + 1`
  | EPipeLambda of id * pats : NEList<LetPattern> * body : Expr

  /// `1 |> (+) 1`
  | EPipeInfix of id * Infix * Expr

  /// `1 |> Json.serialize<Int64>`
  | EPipeFnCall of
    id *
    NameResolution<FQFnName.FQFnName> *
    typeArgs : List<TypeReference> *
    args : List<Expr>

  /// `1 |> Option.Some`
  | EPipeEnum of
    id *
    // TODO: this reference should be by-hash
    typeName : NameResolution<FQTypeName.FQTypeName> *
    caseName : string *
    fields : List<Expr>

  /// ```fsharp
  /// let myLambda = fun x -> x + 1
  /// 1 |> myLambda
  /// ```
  | EPipeVariable of id * varContainingPipeable : string * args : List<Expr>


module Expr =
  let toID (expr : Expr) : id =
    match expr with
    | EUnit id
    | EBool(id, _)
    | EInt8(id, _)
    | EUInt8(id, _)
    | EInt16(id, _)
    | EUInt16(id, _)
    | EInt32(id, _)
    | EUInt32(id, _)
    | EInt64(id, _)
    | EUInt64(id, _)
    | EInt128(id, _)
    | EUInt128(id, _)
    | EChar(id, _)
    | EString(id, _)
    | EFloat(id, _, _, _)
    | EValue(id, _)
    | ELet(id, _, _, _)
    | EIf(id, _, _, _)
    | EInfix(id, _, _, _)
    | ELambda(id, _, _)
    | EFnName(id, _)
    | EVariable(id, _)
    | EArg(id, _)
    | EApply(id, _, _, _)
    | EList(id, _)
    | EDict(id, _)
    | ETuple(id, _, _, _)
    | EPipe(id, _, _)
    | ERecord(id, _, _, _)
    | ERecordUpdate(id, _, _)
    | ERecordFieldAccess(id, _, _)
    | EEnum(id, _, _, _, _)
    | EMatch(id, _, _)
    | EStatement(id, _, _) -> id
    | ESelf id -> id



/// A type defined by a package or canvas/user
module TypeDeclaration =
  type RecordField = { name : string; typ : TypeReference; description : string }

  type EnumField =
    { typ : TypeReference; label : Option<string>; description : string }

  type EnumCase = { name : string; fields : List<EnumField>; description : string }

  /// The right-hand-side of the declaration: eg List<'a>
  type Definition =
    /// `type MyAlias = Int64`
    | Alias of TypeReference

    /// `type MyRecord = { a : int; b : string }`
    | Record of NEList<RecordField>

    /// `type MyEnum = A | B of int | C of int * (label: string)`
    | Enum of NEList<EnumCase>

  /// Combined the RHS definition, with the list of type parameters. Eg type
  /// MyType<'a> = List<'a>
  type T = { typeParams : List<string>; definition : Definition }



/// Used to mark whether a function/type has been deprecated, and if so,
/// details about possible replacements/alternatives, and reasoning
///
/// Our use of this is sort of minimal currently.
/// I'm not sure if it's still an appropriate model going forward.
/// TODO reconsider
/// TODO has this changed at all since -classic? Check the old source.
type Deprecation<'name> =
  | NotDeprecated

  // The exact same thing is available under a new, preferred name
  | RenamedTo of 'name

  /// This has been deprecated and has a replacement we can suggest
  | ReplacedBy of 'name

  /// This has been deprecated and not replaced, provide a message for the user
  | DeprecatedBecause of string


// --
// Package things
// --

type PackageLocation =
  // CLEANUP this doesn't really account for when you're referring to a root 'owner'
  { owner : string
    modules : List<string>
    name : string }


module PackageType =
  // CLEANUP most of the time, the deprecation status isn't a useful thing in F# land.
  // We can (largely) migrate the Deprecation (action) of something, and trim this down to what matters: just the declaration
  // (similarly, the description)
  // (and the hash is sort of an artifact of the declaration)
  // The deprecation is useful for _builtins_ in the cases of PackageValue and PackageFn,
  // but we don't need to manage it as part of _package_ stuff -- right?
  // OK but what do we do about /// comments?
  // really this just begs a series of questions about the PackageManager...
  type PackageType =
    { id : FQTypeName.Package
      declaration : TypeDeclaration.T
      description : string
      deprecated : Deprecation<FQTypeName.FQTypeName> }


module PackageValue =
  type PackageValue =
    { id : uuid
      description : string
      deprecated : Deprecation<FQValueName.FQValueName>
      body : Expr }


module PackageFn =
  type Parameter = { name : string; typ : TypeReference; description : string }

  type PackageFn =
    { id : FQFnName.Package
      body : Expr
      typeParams : List<string>
      parameters : NEList<Parameter>
      returnType : TypeReference
      description : string
      deprecated : Deprecation<FQFnName.FQFnName> }


///
type PackageOp =
  // not handled -- punt: DB operations, Crons, http handlers...
  | AddType of typ : PackageType.PackageType // note: has ID in it
  | AddValue of value : PackageValue.PackageValue
  | AddFn of fn : PackageFn.PackageFn

  // These always happen in the context of a Branch
  // CLEANUP probably extract them to LocationOp, or something
  | SetTypeName of id : FQTypeName.Package * location : PackageLocation
  | SetValueName of id : FQValueName.Package * location : PackageLocation
  | SetFnName of id : FQFnName.Package * location : PackageLocation
// DB should have _history_ of old item names, but only one active PackageLocation


//   | MoveItem of item: uuid * from : Location * to_: Location
//   // we can punt this for now, I think
//   //| MoveModule of from: Location * to_: Location // hmm what about the _timing_ of this?
//   // maybe this isn't supported, and we instead need _many_ moveItem

//   // TODO: support a _reason_ for deprecation
//   // , and an optional pointer to some sort of replacement
//   | DeprecateFn of id: FQFnName.Package
//   | DeprecateValue of id: FQValueName.Package
//   | DeprecateType of id: FQTypeName.Package


// prob belongs in LibMatter
// type BranchMergeConflict =
//   | TypeIntroducedButNotReferenced of FQTypeName.Package
//   | ...IntroducedButNotReferenced of ...



(*
how do we search for things at a location (find me all at Darklang.Stdlib)

select id, owner, modules, name, item_type
from locations
where ... Darklang.Stdlib ???
  and item_type = 'type'

when/how would the item_type fields get populated?
Short answer: while Ops are played out
*)

// I don't think we delete Location records upon something being deprecated.

// We should _generally prevent_ duplicates of owner+modules+name + (deprecated=true)
// Locations table would have a constraint? (warning)

// Ops table needs to record when the Op was saved


// Locations: | id  | owner | modules     | name  | workspace ID | createdAt | deprecatedAt |


// Search: give me everything in Darklang.Stdlib

// select * from locations where owner = darklang and modules like "stdlib%"
// select * from locations where location like "Darklang.Stdlib%"

// scenario: Move fn from filter to filter1
//    | abc | Dark  | Stdlib.List | filter  | oct 1 | null        | null
//    | abc | Dark  | Stdlib.List | filter  | oct 1 | oct 4       | 7cb
//    | abc | Dark  | Stdlib.List | filter1 | oct 4 | null        | 7cb
//    | abc | Dark  | Stdlib.List | filter1 | oct 4 | null        | 6df

// WHat happens when we merge a session:
// For each record in the DB that has our session ID,
// remove the old equivalent session=null records
// set the session id to null for our records
// ?

// constraint on : id * sessionID
// we need some sql trick like: if a session ID is passed in, then use the session-specific record where available

// general principle: anything affected by a session should have sessino-speific records in the DB
// whether something has been moved, or deprecated, or whatever


// if, in my session, I deprecate List.filter
// and then add List.filter2
// then I expect a search to _not_ return List.filter
// but this schema doesn't support htat.
// (nvm it work s- we just need to create another record w/ the deprecation)


// Locations table needs some recording of timing
// a Version field or a createdAt field or something
// oh, then maybe we have deprecatedAt rather than deprecated: bool


// Q: how do we revert things?
// scenario: we merged a branch, and later realized it's problematic.
// (quick note: should be rare - so, notable DB rebuild is OK, maybe?)

//reminder: source of truth is NOT locations table, but is the package_ops table
// a branch being merged causes the Locations and Packages tables to update
// and a revert of that branch needs some complicated process

// Maybe we can't revert a merge of a branch
// BUT we can generate a branch that reverts the merge
// a bunch of Deprecations and name-assignments



// Darklang.Stdlib.List
// -> Darklang.Stdlib.Lists


// // Darklang.Stdlib.List
// // -> Darklang.Stdlib.Lists
//   Move([ID] {"Darklang"; ["Stdlib"] "List"} {"Darklang"; ["Stdlib"] "Lists"})


// // Darklang.Stdlib.List.filter
// // -> Darklang.Stdlib.List.filter2
//   Move([ID] {"Darklang"; ["Stdlib"; "List"] "filter"} {"Darklang"; ["Stdlib"; "List"] "filter2"})

// // if filter2 already exists, then we have a conflict!
// // 2 things at the same Location


type BranchID = uuid
type InstanceID = uuid

/// A package entity paired with its location
type LocatedItem<'T> = { entity : 'T; location : PackageLocation }

module Search =
  /// The type of entity to search for
  type EntityType =
    | Type
    | Module
    | Fn
    | Value

  /// How deep to search in the module hierarchy
  type SearchDepth =
    | OnlyDirectDescendants
    | AllDescendants

  /// Query parameters for searching packages
  type SearchQuery =
    {
      /// i.e. "Darklang.Stdlib"
      currentModule : List<string>

      /// i.e. "List" or "map"
      text : string

      searchDepth : SearchDepth

      /// empty list implies 'any'
      entityTypes : List<EntityType>

      /// if true, require exact matches for names and modules instead of fuzzy matching
      exactMatch : bool
    }

  /// Results from a package search
  type SearchResults =
    { submodules : List<List<string>> // [ [ "List"]; ["String"; "List"] ]
      types : List<LocatedItem<PackageType.PackageType>>
      values : List<LocatedItem<PackageValue.PackageValue>>
      fns : List<LocatedItem<PackageFn.PackageFn>> }

type BranchIDOpt = Option<BranchID>

/// Functionality written in Dark stored and managed outside of user space
///
/// Note: It may be tempting to think the `getX` fns shouldn't return Options,
/// but there's a chance of Local <-> Cloud not being fully in sync,
/// for whatever reasons.
type PackageManager =
  {
    // TODO review all usages - make sure they're not just putting 'None' in
    // i.e. demand the branchID from every usage above.
    // CLEANUP we could/should probably collapse these to just 'find'.
    //   (and getX to just one 'get' by ID+context)
    findType : (BranchIDOpt * PackageLocation) -> Ply<Option<FQTypeName.Package>>
    findValue : (BranchIDOpt * PackageLocation) -> Ply<Option<FQValueName.Package>>
    findFn : (BranchIDOpt * PackageLocation) -> Ply<Option<FQFnName.Package>>

    search : BranchIDOpt * Search.SearchQuery -> Ply<Search.SearchResults>

    // why does the PT one even need these?
    getType : FQTypeName.Package -> Ply<Option<PackageType.PackageType>>
    getValue : FQValueName.Package -> Ply<Option<PackageValue.PackageValue>>
    getFn : FQFnName.Package -> Ply<Option<PackageFn.PackageFn>>

    // Reverse lookups for pretty-printing and other tooling
    // TODO: Revisit this given that a single ID might refer to multiple locations,
    // even per a branch (because... why? not sure or totally convinced either way)).
    getTypeLocation :
      BranchIDOpt * FQTypeName.Package -> Ply<Option<PackageLocation>>
    getValueLocation :
      BranchIDOpt * FQValueName.Package -> Ply<Option<PackageLocation>>
    getFnLocation : BranchIDOpt * FQFnName.Package -> Ply<Option<PackageLocation>>

    init : Ply<unit> }


  static member empty =
    { findType = fun _ -> Ply None
      findFn = fun _ -> Ply None
      findValue = fun _ -> Ply None

      search = fun _ -> Ply { submodules = []; types = []; values = []; fns = [] }

      getType = fun _ -> Ply None
      getFn = fun _ -> Ply None
      getValue = fun _ -> Ply None

      getTypeLocation = fun _ -> Ply None
      getValueLocation = fun _ -> Ply None
      getFnLocation = fun _ -> Ply None

      init = uply { return () } }


  /// Allows you to side-load a few 'extras' in-memory, along
  /// the normal fetching functionality. (Mostly helpful for tests)
  static member withExtras
    (types : List<PackageType.PackageType * PackageLocation>)
    (values : List<PackageValue.PackageValue * PackageLocation>)
    (fns : List<PackageFn.PackageFn * PackageLocation>)
    (pm : PackageManager)
    : PackageManager =

    let typeLocationToId =
      types |> List.map (fun (t, loc) -> loc, t.id) |> Map.ofList
    let typeIdToLocation =
      types |> List.map (fun (t, loc) -> t.id, loc) |> Map.ofList
    let typeIdToType = types |> List.map (fun (t, _) -> t.id, t) |> Map.ofList

    let valueLocationToId =
      values |> List.map (fun (v, loc) -> loc, v.id) |> Map.ofList
    let valueIdToLocation =
      values |> List.map (fun (v, loc) -> v.id, loc) |> Map.ofList
    let valueIdToValue = values |> List.map (fun (v, _) -> v.id, v) |> Map.ofList

    let fnLocationToId = fns |> List.map (fun (f, loc) -> loc, f.id) |> Map.ofList
    let fnIdToLocation = fns |> List.map (fun (f, loc) -> f.id, loc) |> Map.ofList
    let fnIdToFn = fns |> List.map (fun (f, _) -> f.id, f) |> Map.ofList

    { findType =
        fun (branchID, location) ->
          match Map.tryFind location typeLocationToId with
          | Some id -> Ply(Some id)
          | None -> pm.findType (branchID, location)

      findValue =
        fun (branchID, location) ->
          match Map.tryFind location valueLocationToId with
          | Some id -> Ply(Some id)
          | None -> pm.findValue (branchID, location)

      findFn =
        fun (branchID, location) ->
          match Map.tryFind location fnLocationToId with
          | Some id -> Ply(Some id)
          | None -> pm.findFn (branchID, location)

      search = pm.search

      getType =
        fun id ->
          match Map.tryFind id typeIdToType with
          | Some t -> Ply(Some t)
          | None -> pm.getType id

      getValue =
        fun id ->
          match Map.tryFind id valueIdToValue with
          | Some v -> Ply(Some v)
          | None -> pm.getValue id

      getFn =
        fun id ->
          match Map.tryFind id fnIdToFn with
          | Some f -> Ply(Some f)
          | None -> pm.getFn id

      getTypeLocation =
        fun (branchID, id) ->
          match Map.tryFind id typeIdToLocation with
          | Some location -> Ply(Some location)
          | None -> pm.getTypeLocation (branchID, id)

      getValueLocation =
        fun (branchID, id) ->
          match Map.tryFind id valueIdToLocation with
          | Some location -> Ply(Some location)
          | None -> pm.getValueLocation (branchID, id)

      getFnLocation =
        fun (branchID, id) ->
          match Map.tryFind id fnIdToLocation with
          | Some location -> Ply(Some location)
          | None -> pm.getFnLocation (branchID, id)

      init = pm.init }



(*
the source of truth is our core tables, which sync:
  package_ops, branches, instances
  should branch operations be separate from package ops? hmm idk.
  we should sync all ops that you have permissions to...
  oh, how _should_ we do permissioning?
  iI guess there's an SetName thing and later an ApproveName thing? Not sure I actually worked that out...
  | AddBranch? hmm.
  what if an Op referring to a branch is received before the AddBranch op? Prob ignore that for now, right?
  we really need to timestamp these ops in a super-safe way
  I guess working internationally helps us test this a bit...
  what about timezone switches and ... probably need NodaTime if we don't already have it

the package stuff is all a projection of that
  package types, values, fns
  locations, and how they map to those package items
*)





// /// Atomic operations that can be tracked and validated
// module Op =
//   type T =
//     // Content Operations - create new immutable content
//     | AddFunctionContent of hash: string * content: PackageFn.PackageFn
//     | AddTypeContent of hash: string * content: PackageType.PackageType
//     | AddValueContent of hash: string * content: PackageValue.PackageValue

//     // Name Operations - manage name pointers
//     | CreateName of location: PackageLocation.T * hash: string * contentType: string
//     | UpdateNamePointer of location: PackageLocation.T * oldHash: string * newHash: string
//     | MoveName of oldLocation: PackageLocation.T * newLocation: PackageLocation.T
//     | UnassignName of location: PackageLocation.T

//     // Content Operations - deprecate content (by hash)
//     | DeprecateContent of hash: string * reason: string * replacement: string option

// /// Types of conflicts that can occur when we try to apply an Op
// type Conflict =
//   | TODO




// /// A development session
// /// informally a 'branch'
// module Session =
//   type State =
//     | Active
//     | Abandoned
//     | Merged

//   type T = {
//     id: uuid
//     title: string
//     ops: List<uuid>
//     createdAt: System.DateTime
//     lastActiveAt: System.DateTime
//     state: SessionState.T
//     workspace: WorkspaceState.T
//   }



// /// Darklang instance definition -- what can we sync against
// module Instance =
//   type Location =
//     | LocalCLI of pathToExe: string // or maybe this should be path to dir? prob not.
//     | HttpServer of url: string

//   type T = {
//     id: uuid
//     name: string
//     location: Location
//   }





// --
// User things
// --
module DB =
  type T = { tlid : tlid; name : string; version : int; typ : TypeReference }

module Secret =
  type T = { name : string; value : string; version : int }

module Handler =
  type CronInterval =
    | EveryDay
    | EveryWeek
    | EveryFortnight
    | EveryHour
    | Every12Hours
    | EveryMinute

  /// User to represent handlers in their lowest-level form: a triple of space * name * modifier
  /// "Space" is "HTTP", "WORKER", "REPL", etc.
  ///
  /// "Modifier" options differ based on space.
  /// e.g. HTTP handler may have "GET" modifier.
  ///
  /// Handlers which don't have modifiers (e.g. repl, worker) nearly
  /// always (but not actually always) have `_` as their modifier.
  type HandlerDesc = (string * string * string)

  type Spec =
    | HTTP of route : string * method : string
    | Worker of name : string
    | Cron of name : string * interval : CronInterval
    | REPL of name : string

  type T = { tlid : tlid; ast : Expr; spec : Spec }

module Toplevel =
  type T =
    | TLDB of DB.T
    | TLHandler of Handler.T

  let toTLID (tl : T) : tlid =
    match tl with
    | TLDB db -> db.tlid
    | TLHandler h -> h.tlid
